Les Jeux paralympiques sont un événement sportif international majeur, regroupant les sports d’été ou d’hiver, auquel des milliers d’athlètes handicapés participent à travers différentes compétitions tous les quatre ans à la suite des Jeux olympiques, pour chaque olympiade. Y participent des athlètes atteints par un handicap physique, visuel ou mental. Ils sont organisés par le Comité international paralympique (et non pas par le Comité international olympique).
#install.packages("tidyverse")
#install.packages("rvest")
#install.packages("skimr")
#gère différents types de données et renvoie un objet skim_df qui peut être inclus dans un pipeline tidyverse ou affiché de manière élégante pour le lecteur humain.
#install.packages("reshape2")
#Ce package permet surtout le remodelage des données. Ses deux principales fonctions sont la fonction melt, qui permet le passage d’un jeu de données de la mise en forme large à la mise en forme longue, et la fonction cast, qui permet de réaliser l’inverse.
#install.packages("gganimate")
#Ce package permet d’ajouter des animations aux graphiques statiques produits à l’aide de ggplot2
#install.packages("magick")
#Traitement Facile des Images dans R à l’Aide du Package Magick
# Chargement des données et des bibliothèques
library(tidyverse)
library(skimr)
library(knitr)
library(rvest)
library(reshape2)
library(gganimate)
library(magick)
SW <- readr::read_csv('https://raw.githubusercontent.com/youmrg/data_R/main/SW.csv')
SW
## # A tibble: 6,201 x 6
## gender event medal athlete abb year
## <chr> <chr> <chr> <chr> <chr> <dbl>
## 1 Men 25 m Freestyle 1A Gold KENNY Mike GBR 1980
## 2 Men 25 m Freestyle 1A Silver KANTOLA Pekka FIN 1980
## 3 Men 25 m Freestyle 1A Bronze TIETZE H. FRG 1980
## 4 Men 25 m Freestyle 1B Gold BURGER M. CAN 1980
## 5 Men 25 m Freestyle 1B Silver SLUPE G. USA 1980
## 6 Men 25 m Freestyle 1B Bronze MAKI Eero FIN 1980
## 7 Men 25 m Freestyle 1C Gold SMYK Zbigniew POL 1980
## 8 Men 25 m Freestyle 1C Silver EMMEL Manfred FRG 1980
## 9 Men 25 m Freestyle 1C Bronze OCKVIRK Robert USA 1980
## 10 Men 50 m Freestyle CP C Gold ADLER Kare NOR 1980
## # ... with 6,191 more rows
compter les medailles de chaque pays
medal_count<- SW %>%
group_by(abb, medal) %>%
summarize(Count=length(medal))
medal_count
## # A tibble: 172 x 3
## # Groups: abb [67]
## abb medal Count
## <chr> <chr> <int>
## 1 ARG Bronze 9
## 2 ARG Gold 5
## 3 ARG Silver 10
## 4 AUS Bronze 160
## 5 AUS Gold 147
## 6 AUS Silver 158
## 7 AUT Bronze 2
## 8 AUT Gold 2
## 9 AUT Silver 4
## 10 AZE Gold 1
## # ... with 162 more rows
ordonner les pays par nombre de medailles
ord_med <- medal_count %>%
group_by(abb) %>%
summarize(Total=sum(Count)) %>%
arrange(Total) %>%
select(abb)
ord_med
## # A tibble: 67 x 1
## abb
## <chr>
## 1 BAH
## 2 BUL
## 3 KAZ
## 4 LTU
## 5 MAR
## 6 TTO
## 7 VIE
## 8 IPP
## 9 SLO
## 10 TCH
## # ... with 57 more rows
medal_count$abb <- factor(medal_count$abb, levels=ord_med$abb)
le plot
ggplot(medal_count, aes(x=abb, y=Count, fill=medal)) +
geom_col() +
coord_flip() +
scale_fill_manual(values=c("gold1","gray70","gold4")) +
ggtitle("Le classement des pays par le total des médailles ") +
theme(plot.title = element_text(hjust = 0.5))
FR_gold <- SW %>% group_by(year, abb, medal) %>% filter(medal=="Gold", abb=='FRA') %>% summarize(Count=n()) %>% arrange(year) %>% group_by(year)
FR_gold
## # A tibble: 9 x 4
## # Groups: year [9]
## year abb medal Count
## <dbl> <chr> <chr> <int>
## 1 1980 FRA Gold 4
## 2 1984 FRA Gold 35
## 3 1988 FRA Gold 16
## 4 1992 FRA Gold 20
## 5 1996 FRA Gold 12
## 6 2000 FRA Gold 12
## 7 2004 FRA Gold 4
## 8 2008 FRA Gold 2
## 9 2012 FRA Gold 2
Le plot :
ggplot(FR_gold, aes(x=year, y=Count, group=medal)) +
geom_line(aes(colour=abb)) +
geom_point(aes(colour=abb))+
scale_x_continuous(breaks=FR_gold$year)+
theme(legend.position="none", legend.text=element_text(size=0),axis.text.x=element_text(size=8, angle=90,vjust=0,hjust=1))+
labs(title="le Nombre de medailles d'or de la France au fil du temps", x="années", y="Nombre de Medailles")
ggplot(SW,aes(x= gender ,fill= medal))+
geom_bar()+
scale_fill_manual(values=c("gold1","gray70","gold4")) +
ggtitle("nombre de medailles par sex ") +
theme(plot.title = element_text(hjust = 0.5))
ggplot(SW,aes(x= gender ,fill= medal))+
facet_wrap(~ year)+
geom_bar()+
scale_fill_manual(values=c("gold1","gray70","gold4")) +
ggtitle("nombre de medailles par sex pour chaque année ") +
theme(plot.title = element_text(hjust = 0.5))
Tableau de comptage du nombre d’athlètes par année et sexe:
counts_sex <- SW %>%
filter(gender != "Mixed")%>%
group_by(year,gender) %>%
summarize(Athletes = length(unique(athlete)))
counts_sex$year <- as.integer(counts_sex$year)
counts_sex
## # A tibble: 20 x 3
## # Groups: year [10]
## year gender Athletes
## <int> <chr> <int>
## 1 1980 Men 118
## 2 1980 Women 92
## 3 1984 Men 214
## 4 1984 Women 144
## 5 1988 Men 185
## 6 1988 Women 97
## 7 1992 Men 121
## 8 1992 Women 106
## 9 1996 Men 136
## 10 1996 Women 115
## 11 2000 Men 176
## 12 2000 Women 118
## 13 2004 Men 151
## 14 2004 Women 110
## 15 2008 Men 128
## 16 2008 Women 86
## 17 2012 Men 133
## 18 2012 Women 96
## 19 2016 Men 131
## 20 2016 Women 111
Le plot:
ggplot(counts_sex, aes(x=year, y=Athletes, group=gender, color=gender)) +
geom_point(size=2) +
geom_line() +
scale_color_manual(values=c("darkblue","red")) +
labs(title = "Le nombre des hommes et des femmes au fil des années") +
theme(plot.title = element_text(hjust = 0.5))
Le tableau des catégories les plus populaires par sexe :
popu_event <- SW %>%
filter(gender != "Mixed")%>%
group_by(event, gender) %>%
summarize(Count=n()) %>%
group_by(gender) %>%
top_n(5,event)
popu_event
## # A tibble: 10 x 3
## # Groups: gender [2]
## event gender Count
## <chr> <chr> <int>
## 1 50 m Freestyle S5 Women 21
## 2 50 m Freestyle S6 Women 21
## 3 50 m Freestyle S7 Men 21
## 4 50 m Freestyle S7 Women 21
## 5 50 m Freestyle S8 Men 21
## 6 50 m Freestyle S8 Women 21
## 7 50 m Freestyle S9 Men 21
## 8 50 m Freestyle S9 Women 21
## 9 75 m Individual Medley 1A Men 3
## 10 75 m Individual Medley 1B Men 3
Le plot:
ggplot(popu_event, aes(x=event, y=Count, group=gender, label=format(Count, big.mark=".", decimal.mark=","))) +
geom_col(aes(color=gender, fill=gender)) +
geom_text(position=position_stack(vjust=0.5), size=3, check_overlap=TRUE) +
scale_y_discrete() +
theme(legend.position="right", axis.text.x=element_text(size=10, angle=90,vjust=0,hjust=1))+
labs(title="les 5 catégories les plus populaires par sexe", x="Catégories", y="Nombre. athletes")
data_abb_medal <- dcast(medal_count, abb ~ medal)
data_abb_medal[is.na(data_abb_medal)] <- 0
no_gold_data <- subset(data_abb_medal, Gold == 0 & Silver>0 & Bronze>0)
no_gold_data
## abb Bronze Gold Silver
## 10 TCH 1 0 1
## 11 KUW 2 0 1
## 20 ZIM 3 0 2
## 25 POR 6 0 3
## 29 SUI 8 0 4
## 35 URS 9 0 11
print("les pays qui n'ont pas de médaille d'or mais ils ont les autres")
## [1] "les pays qui n'ont pas de médaille d'or mais ils ont les autres"
no_gold_data$abb
## [1] TCH KUW ZIM POR SUI URS
## 67 Levels: BAH BUL KAZ LTU MAR TTO VIE IPP SLO TCH KUW LUX CRO CYP HKG ... GBR
all_medal_sex <- SW%>% group_by(abb, medal, gender) %>%
summarise(total = n())
head(all_medal_sex)
## # A tibble: 6 x 4
## # Groups: abb, medal [4]
## abb medal gender total
## <chr> <chr> <chr> <int>
## 1 ARG Bronze Men 2
## 2 ARG Bronze Women 7
## 3 ARG Gold Women 5
## 4 ARG Silver Men 3
## 5 ARG Silver Women 7
## 6 AUS Bronze Men 63
all_medal_sex.wide <- dcast(all_medal_sex, abb ~ medal+gender)
all_medal_sex.wide[is.na(all_medal_sex.wide)] <- 0
head(all_medal_sex.wide)
## abb Bronze_Men Bronze_Mixed Bronze_Women Gold_Men Gold_Mixed Gold_Women
## 1 ARG 2 0 7 0 0 5
## 2 AUS 63 0 97 72 0 75
## 3 AUT 2 0 0 2 0 0
## 4 AZE 0 0 0 0 0 1
## 5 BAH 0 0 1 0 0 0
## 6 BEL 7 0 6 4 0 2
## Silver_Men Silver_Mixed Silver_Women
## 1 3 0 7
## 2 78 0 80
## 3 4 0 0
## 4 3 0 4
## 5 0 0 0
## 6 7 0 5
no_women_gold <- subset(all_medal_sex.wide, Gold_Women ==0 & Gold_Men>0 )
no_women_gold
## abb Bronze_Men Bronze_Mixed Bronze_Women Gold_Men Gold_Mixed Gold_Women
## 3 AUT 2 0 0 2 0 0
## 7 BLR 9 0 0 21 0 0
## 12 COL 4 0 0 2 0 0
## 14 CUB 2 0 0 1 0 0
## 18 EGY 6 0 0 1 0 0
## 21 EUN 4 0 2 4 0 0
## 28 GRE 10 0 1 10 0 0
## 29 HKG 2 0 1 1 0 0
## 31 IPP 0 0 0 1 0 0
## 39 KOR 6 0 0 7 0 0
## 42 LUX 0 0 0 1 0 0
## 48 PER 2 0 0 2 0 0
## 56 SVK 2 0 1 2 0 0
## 59 THA 4 0 0 1 0 0
## 66 YUG 8 0 1 3 0 0
## Silver_Men Silver_Mixed Silver_Women
## 3 4 0 0
## 7 14 0 0
## 12 5 0 0
## 14 2 0 0
## 18 2 0 0
## 21 2 0 1
## 28 15 0 2
## 29 0 0 0
## 31 1 0 0
## 39 2 0 0
## 42 2 0 0
## 48 1 0 0
## 56 0 0 4
## 59 3 0 0
## 66 6 0 0
print(" Les pays où les femmes n'ont jamis remporté de médaille d'or mais où les hommes l'ont remporté")
## [1] " Les pays où les femmes n'ont jamis remporté de médaille d'or mais où les hommes l'ont remporté"
no_women_gold$abb
## [1] "AUT" "BLR" "COL" "CUB" "EGY" "EUN" "GRE" "HKG" "IPP" "KOR" "LUX" "PER"
## [13] "SVK" "THA" "YUG"
no_men_gold <- subset(all_medal_sex.wide, Gold_Women>0 & Gold_Men==0 )
no_men_gold
## abb Bronze_Men Bronze_Mixed Bronze_Women Gold_Men Gold_Mixed Gold_Women
## 1 ARG 2 0 7 0 0 5
## 4 AZE 0 0 0 0 0 1
## 15 CYP 0 0 1 0 0 2
## 20 EST 1 0 2 0 0 2
## 25 FRO 0 0 5 0 0 1
## 36 JAM 0 0 0 0 0 1
## 38 KAZ 0 0 0 0 0 1
## 53 SGP 0 0 1 0 0 3
## Silver_Men Silver_Mixed Silver_Women
## 1 3 0 7
## 4 3 0 4
## 15 0 0 1
## 20 0 0 5
## 25 0 0 7
## 36 0 0 3
## 38 0 0 0
## 53 0 0 1
print("Les pays où les hommes n'ont jamis remporté de médaille d'or mais où les femmes l'ont remporté")
## [1] "Les pays où les hommes n'ont jamis remporté de médaille d'or mais où les femmes l'ont remporté"
no_men_gold$abb
## [1] "ARG" "AZE" "CYP" "EST" "FRO" "JAM" "KAZ" "SGP"
noc <- readr::read_csv('https://raw.githubusercontent.com/youmrg/data_R/main/noc_regions.csv')
noc = noc %>%
rename(abb = NOC)
noc
## # A tibble: 230 x 3
## abb region notes
## <chr> <chr> <chr>
## 1 AFG Afghanistan <NA>
## 2 AHO Curacao Netherlands Antilles
## 3 ALB Albania <NA>
## 4 ALG Algeria <NA>
## 5 AND Andorra <NA>
## 6 ANG Angola <NA>
## 7 ANT Antigua Antigua and Barbuda
## 8 ANZ Australia Australasia
## 9 ARG Argentina <NA>
## 10 ARM Armenia <NA>
## # ... with 220 more rows
Ajouter les noms complets des pays à notre base
data_regions <- SW %>%
left_join(noc,by="abb") %>%
filter(!is.na(region))
sous ensemble pour les jeux de 1980 et 2016,compter les athletes de chaque pays.
rio <- data_regions %>%
filter(year == "2016") %>%
group_by(region) %>%
summarize(Rio = length(unique(athlete)))
Arnhem_et_Veenendaal<- data_regions %>%
filter(year == "1980") %>%
group_by(region) %>%
summarize(Arnhem = length(unique(athlete)))
Creation des données pour la catographie
world <- map_data("world")
mapdat <- tibble(region=unique(world$region))
mapdat <- mapdat %>%
left_join(Arnhem_et_Veenendaal, by="region") %>%
left_join(rio, by="region")
mapdat$Arnhem[is.na(mapdat$Arnhem)] <- 0
mapdat$Rio[is.na(mapdat$Rio)] <- 0
world <- left_join(world, mapdat, by="region")
la catographie: Arnhem et Veenendaal 1980
ggplot(world, aes(x = long, y = lat, group = group)) +
geom_polygon(aes(fill = Arnhem)) +
labs(title = "Arnhem et Veenendaal 1980",
x = NULL, y = NULL) +
theme(axis.ticks = element_blank(),
axis.text = element_blank(),
panel.background = element_rect(fill = "navy"),
plot.title = element_text(hjust = 0.5)) +
guides(fill=guide_colourbar(title="Athletes")) +
scale_fill_gradient2(low="white",high = "red")
la catographie: Rio 2016
ggplot(world, aes(x = long, y = lat, group = group)) +
geom_polygon(aes(fill = Rio)) +
labs(title = "Rio 2016",
x = NULL, y = NULL) +
theme(axis.ticks = element_blank(),
axis.text = element_blank(),
panel.background = element_rect(fill = "navy"),
plot.title = element_text(hjust = 0.5)) +
guides(fill=guide_colourbar(title="Athletes")) +
scale_fill_gradient2(low="white",high = "red")
Rajouter une colonne continent:
continent <-readr::read_csv('https://raw.githubusercontent.com/youmrg/data_R/main/data.csv')
continent = continent %>%
rename(abb = Three_Letter_Country_Code)
medal_continent <- SW %>%
left_join(continent,by="abb") %>%
filter(!is.na(Continent_Name))
Le nombre de medailles en détail de chaque continent par année :
medal_continent<- medal_continent %>%
group_by(year,Continent_Name) %>%
summarize(Count=length(medal))
medal_continent
## # A tibble: 55 x 3
## # Groups: year [10]
## year Continent_Name Count
## <dbl> <chr> <int>
## 1 1980 Africa 1
## 2 1980 Asia 25
## 3 1980 Europe 238
## 4 1980 North America 119
## 5 1980 Oceania 13
## 6 1980 South America 13
## 7 1984 Africa 1
## 8 1984 Asia 38
## 9 1984 Europe 455
## 10 1984 North America 212
## # ... with 45 more rows
Le total des medailles de chaque continent :
sum_medal_cont <- medal_continent %>%
group_by(Continent_Name) %>%
summarize(nombre_de_medailles=sum(Count))
sum_medal_cont
## # A tibble: 6 x 2
## Continent_Name nombre_de_medailles
## <chr> <int>
## 1 Africa 10
## 2 Asia 765
## 3 Europe 2759
## 4 North America 1088
## 5 Oceania 528
## 6 South America 178
Le pourcentage de chaque continent dans le total des médailles :
pie_chart<- sum_medal_cont %>%
mutate(perc = `nombre_de_medailles` / sum(`nombre_de_medailles`)) %>%
arrange(perc) %>%
mutate(labels = scales::percent(perc))
pie_chart
## # A tibble: 6 x 4
## Continent_Name nombre_de_medailles perc labels
## <chr> <int> <dbl> <chr>
## 1 Africa 10 0.00188 0.2%
## 2 South America 178 0.0334 3.3%
## 3 Oceania 528 0.0991 9.9%
## 4 Asia 765 0.144 14.4%
## 5 North America 1088 0.204 20.4%
## 6 Europe 2759 0.518 51.8%
Le camembert :
ggplot(pie_chart, aes(x = "", y = perc, fill = Continent_Name)) +
geom_col() +
coord_polar(theta = "y")
Nous voulons ici que le nombre de médailles change en fonction des années et des continent. Nous utiliserons alors un diagramme à barres:
plot_anime1 <- ggplot(data = medal_continent) +
geom_col(mapping = aes(x = Continent_Name, y = Count),
fill = "darkcyan") +
theme_classic() +
xlab("Continent") +
ylab("Nombre de médailles ") +
transition_states(year,
transition_length = 2,
state_length = 1,
wrap = TRUE) +
ggtitle("Année : {closest_state}")
plot_anime1
Les diagrammes à barres peuvent être intéressants pour comparer les données d’une seule année à la fois entre elles, mais ne permettent pas de comparer la progression du nombre de medailles par année sur un seul plan de vue. Nous pourrions alors créer un graphique à lignes avec geom_line.
plot_anime2 <- ggplot(data = medal_continent, aes(x = year, y = Count, group=Continent_Name, color=Continent_Name)) +
geom_line() +
geom_point() +
ggtitle("Nombre de médailles entre 1980 et 2016") +
ylab("Nombre de médailles") +
xlab("Année")+
theme_classic()+
view_follow(fixed_x = TRUE,
fixed_y = TRUE) +
transition_reveal(year)
plot_anime2 <- animate(plot_anime2, end_pause = 15)
plot_anime2